;****************************************************************************
; FILE UPLOAD UTILITY FOR CIS A PROTOCOL.
; WRITTEN 3/17/82 BY BOB RICHARDSON
; COPYRIGHT (C) 1982 PERFORMANCE BUSINESS MACHINES
; program distributed by permission- further distribution must contain this
; notice, the copyright notice and the authors name
;
; INVOKED BY "UPLOAD FNAME.FTP" AND USES DEFAULT FCB AND COMMAND LINE 
; *************************************************************************        
.z80
;    equates
soh	equ	01h	; start of header
etx	equ	03h	; end of text 
eot	equ	04h	; end of transmission
enq	equ	05h	; enq char - not used
si	equ	0fh	; shift in - starts protocol on terminal
so	equ	0eh	; shift out - ends protocol
;
knak	equ	15h	; nak
dle	equ	10h	; data link escape - used to mask chars for transparency
esc	equ	1bh	; escape
eof	equ	1ah	; ctl-z
ctlz	equ	1ah	; also
cr	equ	0dh	; carriage return
lf	equ	0ah	; line feed
tof	equ	0ch	; top of form
;
cldboot	equ	00h	; bios coldboot vector
iobyte	equ	0003h	; addr of iobyte
deffcb	equ	05ch	; addr of default fcb
command	equ	080h	; addr of command line	
bdos	equ	05h	; addr of bdos jmp 
; BDOS FUNCTIONS
prnstg  equ	09h	; print string delimited by $
rdcbuf	equ	0ah	; read console buffer function
fn$opn	equ	0fh	; open disk file
fn$cls	equ	010h	; close disk file
fn$del	equ	013h	; delete disk file
fn$rds	equ	014h	; read sequential
fn$wts	equ	015h	; write sequential
fn$mak	equ	016h	; make file
fn$ren	equ	017h	; rename file
fn$std	equ	01ah	; set dma function

;
; BIOS OFFSETS FOR VARIOUS CALLS
const	equ	03h	; constat call
conin	equ	06h	; conin
conout	equ	09h	; character out to console
list	equ	0ch	; character to line printer
punch	equ	0fh	; char to punch device
rdr	equ	12h	; get char from reader device
reader	equ	12h	; alternate spelling
; FCB OFFSETS
current equ	32	; offset to current record number
ftype	equ	09	; and offset to type
; Version info
vers	equ	'1'	; ascii version
rev	equ	'2'	; and rev level  
; History info
; 		3/20/1982     FIRST COMPLETE VERSION RELEASED 
;				BY THE AUTHOR  BOB RICHARDSON OF MICROPRO INTL
;				CORPORATION - FURTHER DISTRIBUTION MUST CONTAIN
;				THIS COMMENT - this file made available courtesy
;				of MicroPro International Corp. and the author
;
;**************************************************************************
;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
; code begins:
; MAIN DRIVER LOOP FOR THE UPLOAD PROTOCOL
;
upld:
	ld	sp,upld		; the Charlie Strom memorial local stack 	
	call	announce	; copyrite and vers, rev level
	call	dskinit		; initialize disk buffer
	call 	procol		; turn on protocol, open file, and start
upldrt:
	call	sndhdr		; then send the header for file xfer
	call	waitack		; and wait for ack response
	jp	c,upldrt	; retry if nak response
	jp	nz,comfail	; error so dump job
	call	sendack		; else prompt for first record
uplp:
	call	getrec		; get terminals record
	jp	c,uplp		; wait for resend if nak	
	ld	a,(seeneot)	; get eotflag
	cp	00h		; and test for completion
	jp	nz,fin		; eof - recd eot record
upl1:
	call	putrec		; write rec(s) to disk
	jp	c,dspacen	; no space on host disk - send fail message
	call	z,sendack
	jp	uplp		; loop till eof
;
fin:
	call	sendack		; ack eot message
	call	complete	; turn off protocol and send all done message 
	call	fclose		; dump buffer tailings if any
	jp 	cldboot 	; terminate
;************************************************************************
; end of driver     beginning of subroutines
biosvct:
	ld	hl,(cldboot+1)	;get start of bios table
	add	hl,de		; get addr for branch
	jp	(hl)		; return handled to inline location
;************************************************************************
; Get rev and version and copyright notice to operator
announce:
	ld	de,cpyrite		; copyright notice
	call	prnmes			; to console
	ret				; to caller
;
cpyrite:
	defb	cr,lf,'Upload Vers. ',vers,'.',rev,cr,lf
	defb	' Copyright (C) 1982  PBM Division MicroPro International Corporation ','$'
;
; **************************************************************************
;  Kudos to Russ Renshaw for inventing this protocol
;  and special thanks to charlie, tom, and dave - sysops of the CIS CP-MIG
;  without whose help none of this code would be here	
; ***************************************************************************
; INITIALIZE THE PROTOCOL AND OPEN FILES
procol:
	ld	de,deffcb	; get default fcb
	ld	c,fn$opn	; open file function
	call	bdos		; see if we can open file
	cp	04h		; test for successful open
	jp	c,isfil		; send file exists message if file there 
	ld	a,(command)	; get count of oper supplied chars
	or	a		; and insure non zero value
	jp	z,nospec	; complain if not right
	ld	hl,deffcb+ftype ; addr of file type
	push	hl		; and save for next use
	ld	de,typsav	; save area
	ld	bc,03h		; length of file type
	ldir 			; move to save area - operator supplied file type
	pop	de		; here is the next use of filetype addr in fcb
	ld	hl,dollar	; $$$ for temporary file type
	ld	bc,03h		; length of file type
	ldir			; move it in
;  the above added for pip compatibility 
	ld	a,0		; get zero
	ld	(masking),a	; and start masking ctl chars in msg text
	call	rmtnm		; prompt operator for name at his end
	ld	a,(conbuff+1)	; start of data - contains byte count
	ld	c,a		; is count for move
	ld	b,0		; with high order=0
	ld	hl,conbuff+2	; start of actual name
	call	noblnk		; bypass all blanks
	jp	z,comfail	; if this passes machine is broken - get a new
				; one.
	ld	de,filespec	; addr in esc a message
	push	bc		; save the number of non blanks
	ldir			; move filespec to message
	pop	hl		; restore count
	ld	a,cr		; get cr to terminate the esc a string
	ld	(de),a		; and move it to the esc a message buffer end
	inc	hl		; update count to reflect this fact
	ld	(tmpsav),hl	; and save for next routine
; here we create the temporary $$$ file on the disk
	ld	de,deffcb	; so make the file - all is well	
	ld	c,fn$del	; first delete it just in case
	push	de		; save for next call
	call	bdos		; to pyramid building routine
	pop	de		; restore fcb pointer		
	ld	c,fn$mak	; make function
	call	bdos		; mush
	cp	04h		; test sucessful completion 
	jp	nc,nodirsp	; else give error for no directory space
	ld	a,0		; get zero
	ld	(deffcb+current),a	; to current record
	ret			; to caller
;
tmpsav:
	defw	00h		; save area for operator count from 
				; remote file name
; **********************************************************************
; send the esc a header to the terminal - refer to the protocol document
; for the format of this record - is essentially the same as normal
; but fields have special meanings.
sndhdr:
; and then turn on protocol in terminal
	ld	a,si		; get shift in char
	call 	punout		; send it
	ld	a,esc		; send esc
	call	punout		; charge
	ld	a,'A'		; esc a for message
	call	punout		; mush ye huskies mush
	ld	hl,(tmpsav)	; get count from operator answer for name
	push 	hl		; move to bc
	ld	hl,escames	; get message balance addr
	pop	bc		; restore count from command line
	ld	a,c		; get count in accumulator
	add	a,escalen	; and add in normal length
	ld	b,a		; get in byte counter
	call	prmesout	; send message as normal
	xor	a		; set z flag
	ret			; and return
; bypass leading blanks in command line
noblnk:
	ld	a,(hl)		; get char
	cp	20h		; test blank
	ret	nz		; non blank
	dec	c		; reduce count
	ret	z		; return error if exhausted
	inc	hl		; increment buffer pointer
	jp	noblnk

; file exists on host- blow off terminal as security measure
;
isfil:
	ld	de,isflmes	; file found message
	call	prnmes		; to console
	jp	cldboot		; and terminate abnormally
;
isflmes:
	defb	cr,lf,'FILE ALREADY EXISTS ON HOST- CHECK DIRECTORY$'
; nospec is issued when user omits the 
; filespec in the command line
nospec:
	ld	de,nospecm	; file found message
	call	prnmes		; to console
	jp	cldboot		; and terminate abnormally
;
nospecm:
	defb	cr,lf,'I am sorry- you must specify a name for upload$'

; error - the host has no directory space
nodirsp:
	ld	de,nodirmes	; no directory space
	call	prnmes		; to console
	jp	cldboot		; and terminate
;
nodirmes:
	defb	cr,lf,'NO DIRECTORY SPACE ON HOST !!!','$'
;
; message for ESC A header - sent if all is well to start upload
escames:
	defb	'U'		; upload
	defb	'B'		; Binary transfer
escalen equ	$-escames	; length for send routine
filespec:
	defs	16h 		; name of file to upload
typsav:
	defs	03h		; save area for file type until sucessfull
dollar:
	defb	'$$$'		; temporary file type in case of io error	
;
;**************************************************************************
;get name for remote computer
; a <cr> response will cause the same name to be used as on host
rmtnm:
	ld	de,remquery		; ask the terminal what it wants to call it
	call	prnmes			; to the operating system such as it is
	ld	de,conbuff		; get a response
	call	rdcon			; and then
	ld	hl,conbuff+2		; convert to insure upper case
	ld	a,(conbuff+1)		; get char count xferred
	cp	0			; insure some characters
	jp	z,naminv		; else take default value
	ld	c,a			; get counter for blank test to 
	call	noblnk			; further insure no error
	jp	z,naminv		; else use same name as on host
	ld	b,a			; in byte counter
; roll lower to upper case if necessary
rmtnm1:
	ld	a,(hl)			; pick up char	
	cp	061h			; test for lower case
	jr	c,rmtntl		; not lower if carry
	cp	07bh			; still looking if less than z
	jr	nc,rmtntl		; so go on about business
	and	05fh			; else roll
	ld	(hl),a			; and save
rmtntl:
	inc	hl			; bump character pointer
	djnz	rmtnm1			; and get next character
	ret				; and return to caller
; use same name as host for remote file
;
naminv:
	ld	hl,command+1		; use the command line input
	ld	de,conbuff+2		; for the remote name
	ld	a,(command)		; length
	ld	c,a			; to counter with
	ld	(conbuff+1),a		; count in command line
	ld	b,0			; zero high order
	ldir				; move characters
	ret				; to caller
;
; buffer for response to filename question 
conbuff:
	defb	010h			; sixteen bytes max I'll allow
	defb	00h			; initial count
	defs	16			; and blank buffer
;
remquery:
	defb	cr,lf,' I need the file name on your computer',cr,lf,'->','$'
;
;			
;***************************************************************************
; TRANSMIT ACK OR NAK TO TERMINAL
sendack:
	ld	a,'.'		; get ack character
	jp	acknak		; branch to common code
;
sendnak:
	ld	a,'/'		; nak char
acknak:
	call	punout		; send it
	scf			; insure carry reset for logic flow in mn loop
	ccf			; could have used or a , i know - good document
	ret			; but thats a subject for another time
;*****************************************************************************
; send a record using the CIS-A protocol
; used primarily for the esc a header in this program
;
prmesout:
	push	bc		; save byte count
	push	hl		; save buffer pointer	
	xor	a		; get zero
	ld	(chksum),a	; and init checksum
	ld	a,soh		; get start of header char
	call	punout		; and send it
	ld	a,(currec)	; get current record
	call	sumupd		; and update checksum
	call	punout		; and send it
	pop	hl		; restore buffer addr
	pop	bc		; restore count to b
;
pmeslp:
	push	hl		; save pointer
	push	bc		; and char count
	ld	a,(hl)		; get char
	call	sumupd		; update checksum
	call	tstmsk		; test if masking necessary
	call	punout		; send char
	pop	bc		; restore count
	pop	hl		; get buffer pointer
	inc	hl		; increment it
	djnz	pmeslp		; and loop until all done
;
	ld	a,etx		; get etx char
	call	punout		; send it
	ld	a,(chksum)	; get check sum
	cp	020h		; test for < ascii space
	jp	nc,pmesl1	; if = or greater, do not mask
	or	040h		; else add to supply transparency
	push	af		; save checksum
	ld	a,dle		; send dle
	call	punout		; to remote
	pop	af		; restore char
pmesl1: 
	call	punout		; send it
	ret			; and return
;*************************************************************************
; Test here for masking of control chars, handle if necessary
; control chars are masked to prevent confusion between innocent bit combos
; and protocol control chars
tstmsk:
	push	af		; save char
	ld	a,(masking)	; get switch value
	cp	00h		; test for on status
	jp	nz,tstmsr	; if off return immediate
	pop	af		; restore original char
	push	af
	cp	05h		; test if one of the offending chars
	jp	c,tstms1	; mask if so
	cp	dle		; or if equal the dle
	jp	z,tstms1	; go masked
	cp	knak		; or if = to 
	jp	z,tstms1	; the fatal nak mask it
; common return
tstmsr:
	pop	af
	ret			; common return if no masking necessary
; masking needed - so mask it
tstms1:
	ld	a,dle		; send dle char first
	call	punout		; and send it
	pop	af		; followed by char+40
	or	040h		; to insure transparecy
	ret	 
;
masking:
	defb	00h		; flag for control char masking
;
;****************************************************************************
; update the checksum
; called whenever we need checksumming - uses simple checksum algorithm
sumupd:
	push	af		; save char
	ld	e,a		; and leave it in reg
	ld	a,(chksum)	; get old checksum
	rlca			; and rotate it
	add	a,e		; add new byte 
	adc	a,0		; and possible carry
	ld	(chksum),a	; and save it
	pop	af		; restore character
	ret			; and return		
;****************************************************************************
; Read a record from the serial port
; using the Compuserve A protocol
getrec:
	xor	a		; init checksum
	ld	(chksum),a	; for use soon
	call	rdrin		; get a char from the rdr device
	cp	etx		; maybe he is just nervous
	jp	z,getrec	; so wait - questionable situation
	cp	soh		; better be an soh
	jp	nz,comfail	; else abort the protocol
; get the terminals record number
	call	rdrin		; get record number
	ld	(trmrno),a	; and save it for later ack/nak branch
	call	sumupd		; and start checksumming 
; set up to fill a buffer
	ld	a,00h		; zero to char count
	ld	(charcnt),a	; for index pointer
	ld	(charcnt+1),a	; both halves must get cleared
	ld	(seeneot),a	; and reset the eot status byte
	ld	hl,buffer	; get address of comm buffer
; then read data until etx
getr1:				; mainloop		
	push	hl		; save the buffer pointer
	call	rdrin		; and get a char
	pop	hl		; restore buffer pointer
	cp	etx		; see if its the end of record
	jp	z,getetx	; so go get checksum if so
	cp	eot		; test for eot
	jp	z,geteot	; and handle if recieved
getr2:
	cp	dle		; was it a masking char?
	jr	nz,getr3	; regular unmasked character
	push	hl		; else get next char
	call	rdrin		; from terminal
	pop	hl		; restore buffer pointer
	and	03fh		; and correct for masking
getr3:
	ld	(hl),a		; save in buffer
	inc	hl		; update pointer
	call	sumupd		; update checksum
	ld	bc,(charcnt)	; update count
	inc	bc		; to reflect chars in buffer
	ld	(charcnt),bc	; merrily counting
	jp	getr1		; and go back for more
;
; here when eot is spotted
geteot:
	ld	(seeneot),a	; set eot recieved flag
	call	sumupd		; update the checksum for eot
	jp	getr1		; and return to loop for etx, chksum
; recvd an etx
getetx: 
	call	rdrin		; get term's checksum
	cp	dle		; see if its masked
	jr	nz,getet1	; and bypass this if not
	call	rdrin		; get real checksum
	and	01fh		; and make it a control char
; validate the transmission
getet1:
	ld	c,a		; and test to see 
	ld	a,(chksum)	; that all is ok
	cp	c		; zero if equal
	jp	nz,getnak	; reject if not
	ld	a,(trmrno)	; get term record number
	ld	c,a		; and save for compare
	ld	a,(currec)	; get what host thinks is current
	sub	c		; and test for terminal high
	jp	c,comfail	; signal communications failure if so
	ld	(trmrno),a	; else save a flag for disk write routine
	call	updrnum		; everything looks ok - we are acking
	xor	a		; so clear carry flag to show all went well
	ret			; and return
; error has occured in xmission
getnak:
	call	sendnak		; something is very wrong- send a nak
	scf			; set the carry flag
	ret			; and retry
; transmission control variables
trmrno:
	defb	00h		; area for term. record number
seeneot:
	defb	00h		; flag to indicate eot detected
charcnt:
	defw	00h		; counter for chars received
;
;
;
;**************************************************************************
; Routine to write the approved characters to disk. only error is no space
; write a record to the disk a character at a time.. 
putrec:
	ld	a,(trmrno)	; get flag for record number
	or	a
	jp	nz,dputfin	; bypass put unless correct record
	ld	hl,buffer	; get start of comm record
	ld	bc,(charcnt)	; and get count of chars
	ld	a,b		; and test for zero error
	or	c		;
	jp	z,dputfin	; bypass putloop if so
;
dputlp:
	ld	a,(hl)		; get the char 
	push	hl		; save the buffer pointer
	push	bc		; save the count
	call	ptchar		; put 1 char to disk stream
	pop	bc		; restore count
	pop	hl		; restore buffer pointer
	inc	hl		; update ptr
	dec	bc		; and update count
	ld	a,b		; test for zero
	or	c		; value in byte counter
	jp	nz,dputlp	; and spin till done
;
dputfin:
	ld	a,(dskerr)	; test for possible disk error
	or	a		; should be zero
	ret	z		; ret good if so
	scf			; else set error for disk space
	ret			; and return
;
; initialize the disk buffer on startup or after a write
dskinit:
	ld	hl,dbuff	; start addr
	ld	de,dbuff+1	; for overlapping move
	ld	bc,buffend-dbuff-1	; buffer length-1 
	ld	a,ctlz		; ctlz to clear with
	ld	(hl),a		; save the seed
	ldir			; and clear
	ret			; to caller
;
; routine to put a character in the disk buffer and write if buffer is full
; writes will ONLY occur on eot or full buffer
ptchar:
	ld	hl,(dpointr)	; get current pointer
	ld	(hl),a		; and save character
	inc	hl		; point to next
	ld	(dpointr),hl	; and save it 
	ld	de,buffend	; get limit
	xor	a		; clear carry
	sbc	hl,de		; test for end
	ret	nz		; return if not boundry
	call	ptitout		; write the record
	ld	hl,dbuff	; re-init pointers
	ld	(dpointr),hl	; for next pass
	call	dskinit		; re-init buffer
	ret			; and return

ptitout:
	ld	de,dbuff	; get dma addr
	ld	c,fn$std	; set dmaadr function
	call	bdos		; to os
	ld	de,deffcb	; fcbaddr
	ld	c,fn$wts	; write sequential function
	call	bdos		; and its done
	ld	(dskerr),a	; save possible error status
	ret			; and return to caller
;
; close the file and write record if non-empty
fclose:
	ld	hl,(dpointr)	; get pointer value
	ld	de,dbuff	; and init value
	xor	a		; clear carry
	sbc	hl,de		; is pointer at start of buffer??
	jr	z,fclos1	; yes, bypass flush
	call	ptitout
; close the file and rename it to the originally specified name
fclos1:  
	ld	de,deffcb	; for file close function
	ld	c,fn$cls	; the aforementioned function
	call	bdos		; close and go
	ld	de,deffcb+16	; get next 16 for rename setup
	xor	a		; clear drive byte
	inc	de
	ld	(de),a		; for later
	ld	hl,deffcb+1	; and point to old name
	ld	bc,08h		; length for move
	ldir			; move in file name
	ld	hl,typsav	; get original file type
	ld	bc,03h		; and length
	ldir			; and move it in too
	ld	c,fn$ren	; rename function change fil.$$$ to fil.ext
	ld	de,deffcb	; addr of fcb for renamed file
	call	bdos		; rename it
	ret			; to caller	
;
dskerr:
	defb	00h
;
;*************************************************************************
; Communications have failed - reset everything and split
;
comfail:
	ld	a,knak		; send physical abort character
	call	punout		; and abort
	ld	de,failmes	; get comm failure message
	call	prnmes		; send message
	ld	de,deffcb	; and delete any file by that name
	ld	c,fn$del	; delete function
	call	bdos		; go out in the best way 
	jp	cldboot		; and abort
;
failmes:
	defb	CR,LF,' Communications Failure - Upload aborted','$'
;**********************************************8
; Host is out of disk space
dspacen:
	ld	a,knak		; send physical abort character
	call	punout		; and abort
	ld	de,dspcmes	; get comm failure message
	call	prnmes		; send message
	jp	cldboot		; and abort
;
dspcmes:
	defb	cr,lf,' Host out of disk space - Upload aborted','$'
;
;************************************************************************** 
; EOF - send a good eot message to let host know we are done
puteot:
	ld	a,0ffh		; turn of the switch to insure
	ld	(masking),a	; that eot is sent unmasked
;
	ld	hl,eotmes	; get addr of eot char
	ld	b,1		; setup
	call	prmesout	; and send it
	ret
complete:
	ld	a,so		; turn off protocol mode at terminal
	call	punout		; now
	ld	de,ucommes	; get upload complete
	call	prnmes		; send it 
;
	ret
ucommes:
	defb	cr,lf,' UPLOAD COMPLETE ','$'
eotmes:
	defb	eot
;**********************************************************************
; Wait for an ack from the terminal
waitack:
	call	pcharin		; get protocol char
	cp	'.'		; is it ack
	jp	z,gotack	; then handle
	cp	'/'		; is it nak?
	jp	z,rexmit	; then retransmit
	cp	knak		; check for abort
	jp	nz,waitack	; else loop
;
	ld	a,01		; set nz, clear carry
	or	a		; and return
	ret
;
rexmit:
	scf			; return carry set
	ret
;
gotack:
	call	updrnum		; update current record number
	xor	a		; set zero flag and clear carry
	ret	
;**************************************************************************
; update current record number
updrnum:
	ld	a,(currec)	; get current record number
	inc	a		; and increment
	cp	'9'+1		; test for overflow
	jr	c,updrok	; still valid if carry
	ld	a,'0'		; else change it
updrok:		
	ld	(currec),a	; and save result
	ret			; then return
;****************************************************************************
; START OF IO ROUTINES - THESE ROUTINES MAY BE MODIFIED AS REQUIRED TO SUPPORT
; THE USERS HARDWARE ENVIRONMENT
;****************************************************************************
; send a message to terminal using print string convention - this routine
; assumes terminal is accessible as console and uses bdos
prnmes:
	ld	c,prnstg	; settup function number
	call	bdos		; call the operating system
	ret			; and return
;***************************************************************************
; this routine reads a standard console buffer from the operator- again, using
; bdos
rdcon:
	ld	c,rdcbuf	; read console buffer function
	call	bdos		; to os
	ret			; to caller	

;***********************************************************************
; This routine uses the bios punch call to access the console port
; the routine must send the char in a to the modem without stripping parity
;
punout:
	push	af		; save char
	ld	c,a		; get char in proper register
	ld	de,punch	; get offset
	call	biosvct		; go doit
	pop	af		; restore char
	ret
;**************************************************************************
; This routine calls the bios reader input to get an 8 bit character
; character is returned in a with parity bit INTACT!
rdrin:
	ld	de,reader	; get proper offset
	call	biosvct		; go get the char
	cp	knak		; see it its knak
	jp	z,comfail	; comm failure if so 
	ret	
;
; *************************************************************************
; read one char from modem - parity may be stripped
pcharin:
	ld	de,conin	; get 1 char via bios
	call	biosvct		; and return
	ret			; to caller

;	
currec:
	defb	'1'		; initial record number
chksum:
	defb	00h		; initial check sum
dpointr:
	defw	dbuff		; initial pointer value

;
;
dbuff:
	ds	128		; dma address
buffend equ	$
buffer	equ	$	
	end
